home *** CD-ROM | disk | FTP | other *** search
/ El Mac 7 / El Mac 7.iso / De la revista / Ghostscript / files / gs_setpd.ps < prev    next >
Encoding:
Text File  |  1994-04-25  |  10.0 KB  |  325 lines  |  [TEXT/gsVR]
  1. %    Copyright (C) 1994, 1995 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % The current implementation of setpagedevice has the following problems:
  19. %    - It doesn't save the CTM after the Install procedure as the
  20. % one for initmatrix or defaultmatrix.
  21. %    - It doesn't interact properly with gsave/grestore.
  22. %    - It doesn't do the automatic 90 degree rotation if the PageSize
  23. % dimensions need to be swapped.
  24. %    - It doesn't handle Policy values other than 1 or non-1.
  25.  
  26. languagelevel 1 .setlanguagelevel
  27. level2dict begin
  28.  
  29. % Define currentpagedevice so it creates the dictionary on demand if needed.
  30. % The only entry we add automatically is Policies.
  31. /currentpagedevice
  32.  { .currentpagedevice dup length 0 eq
  33.     { pop currentdevice null .getdeviceparams
  34.         % In case of duplicate keys, .dicttomark takes the entry
  35.         % lower on the stack, so we can just append the defaults here.
  36.       /Policies .defaultpolicies .dicttomark
  37.       dup .setpagedevice
  38.     }
  39.    if
  40.  } bind odef
  41.  
  42. % The implementation of setpagedevice is quite complex.  Currently,
  43. % everything but the media matching algorithm is implemented here.
  44.  
  45. % Define the parameters that require special action to merge into the
  46. % combined page device dictionary.  The procedures are called as follows:
  47. %    <merged> <key> <new_value> -proc- <merged> <key> <new_value'>
  48. /.mergespecial mark
  49.   /InputAttributes
  50.    { dup null eq
  51.       { pop null
  52.       }
  53.       { 3 copy pop .knownget
  54.      { dup null eq
  55.         { pop dup length dict }
  56.         { dup length 2 index length add dict copy }
  57.        ifelse
  58.      }
  59.      { dup length dict
  60.      }
  61.         ifelse copy readonly
  62.       }
  63.      ifelse
  64.    } bind
  65.   /OutputAttributes 1 index
  66.   /Policies
  67.     { 3 copy pop .knownget
  68.        { dup length 2 index length add dict copy }
  69.        { dup length dict }
  70.       ifelse copy readonly
  71.     } bind
  72. .dicttomark readonly def
  73.  
  74. % Define the keys used in input attribute matching.
  75. /.inputattrkeys [
  76.   /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet
  77. ] readonly def
  78.  
  79. % Define the keys used in output attribute matching.
  80. /.outputattrkeys [
  81.   /OutputType
  82. ] readonly def
  83.  
  84. % Define the parameters that should not be presented to the device.
  85. % The procedures are called as follows:
  86. %    <merged> <key> <value> -proc-
  87. % The procedure leaves all its operands on the stack and returns
  88. % true iff the key/value pair should be presented to .putdeviceparams.
  89. /.presentspecial mark
  90.   /Name false
  91.   /OutputDevice false
  92.   /InputAttributes false
  93.   .inputattrkeys { pop { 2 index /InputAttributes get null eq } } forall
  94.   /OutputAttributes false
  95.   .outputattrkeys { pop { 2 index /OutputAttributes get null eq } } forall
  96.   /Install false
  97.   /BeginPage false
  98.   /EndPage false
  99.   /Policies false
  100. .dicttomark readonly def
  101.  
  102. % Define the required attributes of all page devices, and their default values.
  103. % We don't include attributes such as PageSize, which all devices
  104. % are guaranteed to supply on their own.
  105. /.defaultpolicies mark
  106.   /PolicyNotFound 1
  107.   /PageSize 0
  108.   /PolicyReport {pop} bind
  109. .dicttomark readonly def
  110. /.requiredattrs mark
  111.   /InputAttributes mark 0 0 dict .dicttomark
  112.   /OutputAttributes mark 0 0 dict .dicttomark
  113.   /Install {.callinstall} bind
  114.   /BeginPage {.callbeginpage} bind
  115.   /EndPage {.callendpage} bind
  116.   /Policies .defaultpolicies
  117. .dicttomark readonly def
  118.  
  119. % Define access to device defaults.
  120. /.defaultdevicename 0 .getdevice .devicename def
  121. /.defaultdeviceparams
  122.  { finddevice null .getdeviceparams
  123.  } bind def
  124.  
  125. % Select media (input or output).  The hard work is done in an operator:
  126. %    <pagedict> <attrdict> <keys> .matchmedia <key> true
  127. %    <pagedict> <attrdict> <keys> .matchmedia false
  128. %    <pagedict> null <keys> .matchmedia null true
  129. /.selectmedia        % <orig> <request> <merged> <failed>
  130.             %   (these are retained)
  131.             %   <attrdict> <attrkeys> <mediakey> .selectmedia
  132.  { 4 index 4 -1 roll 3 index .matchmedia
  133.     { 4 index 3 1 roll put pop
  134.     }
  135.     {    % Adobe's implementations have a "big hairy heuristic"
  136.     % to choose the set of keys to report as having failed the match.
  137.     % For the moment, we report any keys that are in the request
  138.     % and don't have the same value as in the original dictionary.
  139.       3 index exch undef
  140.        {    % Stack: <orig> <request> <merged> <failed> <attrkey>
  141.      3 index 1 index .knownget
  142.       { 5 index 2 index .knownget { ne } { pop true } ifelse }
  143.       { true }
  144.      ifelse        % Stack: ... <failed> <attrkey> <report>
  145.       { 2 copy /rangecheck put }
  146.      if pop
  147.        }
  148.       forall
  149.     }
  150.    ifelse
  151.  } bind def
  152.  
  153. % Apply Policies to any unprocessed failed requests.
  154. % As we process each request entry, we replace the error name
  155. % in the <failed> dictionary with the policy value,
  156. % and we remove the key from the <merged> dictionary.
  157. /.applypolicies        % <merged> <failed> .applypolicies <merged'> <failed'>
  158.  { 1 index /Policies get 1 index
  159.     { type /integertype eq
  160.        { pop        % already processed
  161.        }
  162.        { 2 copy .knownget not { 1 index /PolicyNotFound get } if
  163.             % Stack: <merged> <failed> <Policies> <key> <policy>
  164.      dup 1 ne
  165.       {    % Set errorinfo and signal a configurationerror.
  166.         % Note that we currently treat all Policy values other than 1
  167.         % the same as 0.
  168.         pop dup 4 index exch get 2 array astore
  169.         $error /errorinfo 3 -1 roll put
  170.         cleartomark
  171.         /setpagedevice load /configurationerror signalerror
  172.       }
  173.       {    % Ignore the failed request.
  174.         3 index 2 index 3 -1 roll put
  175.         3 index exch undef
  176.       }
  177.      ifelse
  178.        }
  179.       ifelse
  180.     }
  181.    forall pop
  182.  } bind def
  183.  
  184. % Try setting the device parameters from the merged request.
  185. /.trysetparams        % ... <merged> <(ignored)> <device> <Policies>
  186.             %   .trysetparams
  187.  { true mark 5 index dup
  188.     {            % Stack: <merged> <key> <value>
  189.       .presentspecial 2 index .knownget
  190.        { exec { 3 -1 roll } { pop pop } ifelse }
  191.        { 3 -1 roll }
  192.       ifelse
  193.     }
  194.    forall pop
  195. DEBUG { (Putting.\n) print pstack flush } if
  196.    .putdeviceparams
  197. DEBUG { (Result of putting.\n) print pstack flush } if
  198.  } bind def
  199.  
  200. % Finally, define setpagedevice.
  201. /setpagedevice
  202.  {
  203.    mark exch currentpagedevice
  204.  
  205.         % Check whether we are changing OutputDevice;
  206.         % also handle the case where the current device
  207.         % is not a page device.
  208.         % Stack: mark <request> <current>
  209. DEBUG { (Checking.\n) print pstack flush } if
  210.  
  211.    dup /OutputDevice .knownget
  212.     {        % Current device is a page device.
  213.       2 index /OutputDevice .knownget
  214.        {    % A specific OutputDevice was requested.
  215.      2 copy eq
  216.       { pop pop null }
  217.       { exch pop }
  218.      ifelse
  219.        }
  220.        { pop null
  221.        }
  222.       ifelse
  223.     }
  224.     {        % Current device is not a page device.
  225.         % Use the default device.
  226.       1 index /OutputDevice .knownget not { .defaultdevicename } if
  227.     }
  228.    ifelse
  229.    dup null eq
  230.     { pop
  231.     }
  232.     { exch pop .defaultdeviceparams
  233.         % In case of duplicate keys, .dicttomark takes the entry
  234.         % lower on the stack, so we can just append the defaults here.
  235.       .requiredattrs { } forall .dicttomark
  236.     }
  237.    ifelse
  238.  
  239.         % Merge the current and requested dictionaries.
  240.         % Stack: mark <request> <orig>
  241. DEBUG { (Merging.\n) print pstack flush } if
  242.  
  243.    exch 1 index dup length 2 index length add dict copy
  244.    dup 2 index
  245.     {        % stack: <orig> <request> <merged> <merged> <rkey> <rvalue>
  246.       .mergespecial 2 index .knownget { exec } if
  247.       put dup
  248.     }
  249.    forall pop
  250.  
  251.         % Select input and output media.
  252.         % Stack: mark <orig> <request> <merged>
  253. DEBUG { (Selecting.\n) print pstack flush } if
  254.  
  255.    0 dict    % <failed>
  256.    1 index /InputAttributes .knownget
  257.     { .inputattrkeys (%MediaSource) cvn .selectmedia } if
  258.    1 index /OutputAttributes .knownget
  259.     { .outputattrkeys (%MediaDestination) cvn .selectmedia } if
  260.    .applypolicies
  261.  
  262.         % Construct the new device, and attempt to set its attributes.
  263.         % Stack: mark <orig> <request> <merged> <failed>
  264. DEBUG { (Constructing.\n) print pstack flush } if
  265.  
  266.    currentdevice .devicename 2 index /OutputDevice get eq
  267.     { currentdevice }
  268.     { 1 index /OutputDevice get finddevice }
  269.    ifelse
  270.         %**************** We should copy the device here,
  271.         %**************** but since we can't close the old device,
  272.         %**************** we don't.  This is WRONG.
  273.     %****************copydevice
  274.    2 index /Policies get
  275.    .trysetparams
  276.    dup type /nametype eq
  277.     {        % The request failed.
  278.         % Stack: ... <failed> <device> <Policies> true mark
  279.         %   <name> <errorname> ...
  280.       counttomark 5 add -1 roll
  281.       counttomark 2 idiv { dup 4 -2 roll put } repeat
  282.       exch pop 4 1 roll pop
  283.         % Stack: mark ... <merged> <failed> <device> <Policies>
  284.       4 2 roll .applypolicies 4 -2 roll
  285.       .trysetparams        % shouldn't fail!
  286.       dup type /booleantype ne
  287.        { 2 { counttomark 1 add 1 roll cleartomark } repeat
  288.          /setpagedevice load exch signalerror
  289.        }
  290.       if
  291.     }
  292.    if
  293.  
  294.         % The attempt succeeded.  Install the new device.
  295.         % Stack: mark ... <merged> <failed> <device> <eraseflag>
  296. DEBUG { (Installing.\n) print pstack flush } if
  297.  
  298.    pop 2 .endpage
  299.     { 1 true .outputpage
  300.       (>>setpagedevice, press <return> to continue<<\n) .confirm
  301.     }
  302.    if
  303.    .setdevice pop
  304.    1 index /Install .knownget { exec } if
  305.    erasepage initgraphics
  306.    1 index .setpagedevice .beginpage
  307.  
  308.         % Clean up, calling PolicyReport if needed.
  309.         % Stack: mark ... <merged> <failed>
  310. DEBUG { (Finishing.\n) print pstack flush } if
  311.  
  312.    dup length 0 ne
  313.     { 1 index /Policies get /PolicyReport get
  314.       counttomark 1 add 2 roll cleartomark
  315.       exec
  316.     }
  317.     { cleartomark
  318.     }
  319.    ifelse
  320.  
  321.  } odef
  322.  
  323. end                % level2dict
  324. .setlanguagelevel
  325.